home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tl / char-util.el.z / char-util.el
Encoding:
Text File  |  1998-05-21  |  2.5 KB  |  95 lines
  1. ;;; char-util.el --- character utility
  2.  
  3. ;; Copyright (C) 1996,1997 MORIOKA Tomohiko
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Version: $Id: char-util.el,v 1.3 1997/01/18 09:48:31 morioka Exp $
  7. ;; Keywords: character, Emacs/mule
  8.  
  9. ;; This file is not part of tl (Tiny Library).
  10.  
  11. ;; This program is free software; you can redistribute it and/or
  12. ;; modify it under the terms of the GNU General Public License as
  13. ;; published by the Free Software Foundation; either version 2, or (at
  14. ;; your option) any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Code:
  27.  
  28. (defun row-line-to-char (r l)
  29.   (int-char (+ (* r 16) l))
  30.   )
  31.  
  32. (defun row-line-to-string (r l)
  33.   (char-to-string (row-line-to-char r l))
  34.   )
  35.  
  36. (defun print-row-line (r l)
  37.   (interactive (and (looking-at "\\([0-9]+\\)/\\([0-9]+\\)")
  38.             (list (string-to-number
  39.                (buffer-substring (match-beginning 1)
  40.                          (match-end 1)))
  41.               (string-to-number
  42.                (buffer-substring (match-beginning 2)
  43.                          (match-end 2)))
  44.               )))
  45.   (message (row-line-to-string r l))
  46.   )
  47.  
  48. (defun char-to-row-line-form (chr)
  49.   (setq chr (char-int chr))
  50.   (format "%d/%d" (/ chr 16)(mod chr 16))
  51.   )
  52.  
  53. (defun char-to-byte-list (chr)
  54.   (let ((rest (mapcar (function identity)
  55.               (char-to-string chr))
  56.           ))
  57.     (if (cdr rest)
  58.     (cons (car rest)
  59.           (mapcar (lambda (byte)
  60.             (logand byte 127)
  61.             )
  62.               (cdr rest)))
  63.       (cons 'ascii rest)
  64.       )))
  65.  
  66. (defun char-to-row-cell-form (chr)
  67.   (let ((cl (char-to-byte-list chr)))
  68.     (if (= (length cl) 2)
  69.     (char-to-row-line-form (nth 1 cl))
  70.       (format "%02d-%02d" (- (nth 1 cl) 32)(- (nth 2 cl) 32))
  71.       )))
  72.  
  73. (defun show-char-info (char)
  74.   (interactive (list (char-after (point))))
  75.   (let ((cl (char-to-byte-list char)))
  76.     (message (format "%s: %s %s"
  77.              (charset-description (car cl))
  78.              (mapconcat (lambda (byte)
  79.                   (format "%02x" byte)
  80.                   )
  81.                 (cdr cl) "")
  82.              (if (= (length cl) 2)
  83.              (char-to-row-line-form (nth 1 cl))
  84.                (format "%02d-%02d" (- (nth 1 cl) 32)(- (nth 2 cl) 32))
  85.                )
  86.              ))))
  87.  
  88.  
  89. ;;; @ end
  90. ;;;
  91.  
  92. (provide 'char-util)
  93.  
  94. ;;; char-util.el ends here
  95.